# File transfer via Stream Initiation (XEP-0096)

###############################################################################

namespace eval si {
    set winid 0
    set chunk_size 1024

    variable options

    custom::defgroup {Stream Initiation} \
	[::msgcat::mc "Stream initiation options."] \
	-group {File Transfer}
}

set ::NS(file-transfer) http://jabber.org/protocol/si/profile/file-transfer

###############################################################################

proc si::send_file {token} {
    upvar #0 $token state
    variable chunk_size

    if {![info exists state(fd)]} return

    set state(stream) [si::newout $state(connid) $state(jid)]

    set profile [jlib::wrapper:createtag file \
		     -vars [list xmlns $::NS(file-transfer) \
				 name $state(name) \
				 size $state(size)] \
		     -subtags [list [jlib::wrapper:createtag desc \
					 -chdata $state(desc)]]]

    si::connect $state(stream) $chunk_size application/octet-stream \
		$::NS(file-transfer) $profile \
		[list [namespace current]::send_file_result $token]
}

###############################################################################

proc si::send_file_result {token res} {
    upvar #0 $token state

    if {![info exists state(fd)]} return

    if {![lindex $res 0]} {
	eval $state(command) ERR \
	     [list [::msgcat::mc "Request failed: %s" [lindex $res 1]]]
	return
    }

    set_status [::msgcat::mc "Transferring..."]
    after idle [list [namespace current]::send_chunk $token]
}

proc si::send_chunk {token} {
    upvar #0 $token state
    variable chunk_size

    if {![info exists state(fd)]} return

    set chunk [read $state(fd) $chunk_size]
    if {$chunk != ""} {
	si::send_data $state(stream) $chunk \
		      [list [namespace current]::send_chunk_response $token]
    } else {
	eval $state(command) OK
    }
}

proc si::send_chunk_response {token res} {
    upvar #0 $token state

    if {![info exists state(fd)]} return

    if {![lindex $res 0]} {
	eval $state(command) ERR \
	     [list [::msgcat::mc "Transfer failed: %s" [lindex $res 1]]]
	return
    }

    eval $state(command) [list PROGRESS [tell $state(fd)]]
    after idle [list [namespace current]::send_chunk $token]
}

###############################################################################

proc si::send_file_close {token} {
    upvar #0 $token state

    if {![info exists state(stream)]} return

    catch {si::close $state(stream)}
    catch {si::freeout $state(stream)}
}

###############################################################################
###############################################################################

proc si::recv_file_dialog {connid from lang id name size date hash desc} {
    variable winid

    set token [namespace current]::[incr winid]
    upvar #0 $token state

    set w .rfd$winid
    set state(w) $w

    set state(connid) $connid
    set state(jid) $from
    set state(lang) $lang
    set state(id) $id

    Dialog $w -title [format [::msgcat::mc "Receive file from %s"] $from] \
	-separator 1 -anchor e \
	-modal none -default 0 -cancel 1


    set f [$w getframe]

    label $f.lname -text [::msgcat::mc "Name:"]
    label $f.name -text $name

    label $f.lsize -text [::msgcat::mc "Size:"]
    label $f.size -text $size

    label $f.ldesc -text [::msgcat::mc "Description:"]
    message $f.desc -width 10c -text $desc

    set dir $ft::options(download_dir)
    label $f.lsaveas -text [::msgcat::mc "Save as:"]
    entry $f.saveas -textvariable ${token}(filename)

    set state(f) $f

    set state(size) $size

    set state(dir) $dir
    set state(name) $name
    set state(filename) [file join $dir $name]
    button $f.browsefile -text [::msgcat::mc "Browse..."] \
	-command [list [namespace current]::set_receive_file_name $token]

    set state(progress) 0

    # Working around a bug in ProgressBar:
    # crash when setting PB variable while -maximum is 0:
    if {$size > 0} {
	ProgressBar $f.pb -variable ${token}(progress)
	$f.pb configure -maximum $size
	grid $f.pb  -row 5 -column 0 -sticky ew -columnspan 3 -pady 2m
    }

    # grid row 0 is used for displaying error messages

    grid $f.lname   -row 1 -column 0 -sticky e
    grid $f.name    -row 1 -column 1 -sticky w

    grid $f.lsize   -row 2 -column 0 -sticky e
    grid $f.size    -row 2 -column 1 -sticky w

    grid $f.ldesc   -row 3 -column 0 -sticky en
    grid $f.desc    -row 3 -column 1 -sticky ewns -columnspan 2 -pady 1m

    grid $f.lsaveas -row 4 -column 0 -sticky e
    grid $f.saveas  -row 4 -column 1 -sticky ew
    grid $f.browsefile  -row 4 -column 2 -sticky ew

    grid columnconfigure $f 1 -weight 1 -minsize 8c
    grid rowconfigure $f 3 -weight 1
    
    $w add -text [::msgcat::mc "Receive"] -command \
	[list [namespace current]::recv_file_start $token]
    $w add -text [::msgcat::mc "Cancel"] -command \
	[list [namespace current]::recv_file_cancel $token]
    
    bind $w <Destroy> [list [namespace current]::recv_file_close $token $w %W]

    $w draw

    # Can't avoid vwait, because this procedure must return result or error
    vwait ${token}(result)

    lassign $state(result) destroy result
    if {$destroy} {
	destroy $state(w)
    }

    return $result
}

proc si::set_receive_file_name {token} {
    upvar #0 $token state

    set file [tk_getSaveFile -initialdir $state(dir) \
			     -initialfile $state(name)]
    if {$file != ""} {
	set state(filename) $file
    }
}

###############################################################################

proc si::recv_file_cancel {token} {
    upvar #0 $token state

    if {![info exists state(result)]} {
	set state(result) [list 1 [list error cancel not-allowed \
					-text [::trans::trans $state(lang) \
						   "File transfer is refused"]]]
    } elseif {[info exists state(w)] && [winfo exists $state(w)]} {
	destroy $state(w)
    }
}

###############################################################################

proc si::recv_file_start {token} {
    upvar #0 $token state

    ft::hide_error_msg $state(f)

    if {[catch {open $state(filename) w} fd]} {
	ft::report_cannot_open_file $state(f) $state(filename) \
				    [ft::get_POSIX_error_desc]
	return
    }

    fconfigure $fd -translation binary

    $state(w) itemconfigure 0 -state disabled

    if {[catch {si::newin $state(connid) $state(jid) $state(id)} stream]} {
	# Return error to the sender but leave transfer window with disabled
	# 'Receive' button and error message.
	set state(result) [list 0 [list error modify bad-request \
					    -text [::trans::trans $state(lang) \
						       "Stream ID is in use"]]]
	ft::report_error $state(f) \
	    [error_to_string [::msgcat::mc "Receive error: Stream ID is in use"]]
	return
    }

    set state(stream) $stream

    set state(fd) $fd

    si::set_readable_handler \
	$stream [list [namespace current]::recv_file_chunk $token]
    si::set_closed_handler \
	$stream [list [namespace current]::closed $token]

    set state(result) [list 0 {}]
}

###############################################################################

proc si::recv_file_chunk {token stream} {
    upvar #0 $token state

    if {![info exists state(w)] || ![winfo exists $state(w)]} {return 0}
    if {![info exists state(stream)] || !($state(stream) == $stream)} {return 0}

    set fd $state(fd)
    set filename $state(filename)
    set data [si::read_data $stream]

    debugmsg filetransfer "RECV into $filename data $data"

    puts -nonewline $fd $data
    set state(progress) [tell $fd]

    return 1
}

###############################################################################

proc si::closed {token stream} {
    upvar #0 $token state

    if {![info exists state(w)] || ![winfo exists $state(w)]} {return 0}
    if {![info exists state(stream)] || !($state(stream) == $stream)} {return 0}

    debugmsg filetransfer "CLOSE"
    destroy $state(w)
}

###############################################################################

proc si::recv_file_close {token w1 w2} {
    upvar #0 $token state

    if {$w1 != $w2} return

    catch {close $state(fd)}
    catch {si::freein $state(stream)}
    catch {unset $token}
}

###############################################################################
###############################################################################

proc si::si_handler {connid from lang id mimetype child} {
    debugmsg filetransfer "SI set: [list $from $child]"

    jlib::wrapper:splitxml $child tag vars isempty chdata children

    if {$tag == "file"} {
	set desc ""
	foreach item $children {
	    jlib::wrapper:splitxml $item tag1 vars1 isempty1 chdata1 children1
	    switch -- $tag1 {
		desc {set desc $chdata1}
	    }
	}

	recv_file_dialog \
	    $connid \
	    $from \
	    $lang \
	    $id \
	    [jlib::wrapper:getattr $vars name] \
	    [jlib::wrapper:getattr $vars size] \
	    [jlib::wrapper:getattr $vars date] \
	    [jlib::wrapper:getattr $vars hash] \
	    $desc
    } else {
	return [list error modify bad-request]
    }
}

si::register_profile $::NS(file-transfer) [namespace current]::si::si_handler

###############################################################################

ft::register_protocol si \
    -priority 10 \
    -label "Stream Initiation" \
    -send [namespace current]::si::send_file \
    -close [namespace current]::si::send_file_close

###############################################################################

